perm filename SUBR4.F4[MUS,LCS] blob sn#168155 filedate 1975-07-10 generic text, type T, neo UTF8
00100	C   SUBR4.F4
00200	C  THIS SUBR. ALLOWS RAND. SELECTION FROM UP TO 5 RHYTHMIC STRINGS
00300	C OF UP TO 19 UNITS EACH.  (2OTH UNIT IS END MARK.)
00400	
00500		SUBROUTINE SUBR
00600		COMMON /INS/ INST(27),BG(60)
00700		COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
00800	C   INUM=INST#  IPAR=PARAM#  
00900	C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
01000	C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
01100	C   INST=INST. NAME,  BG=INSTS' BEGIN TIMES.
01200	C   NOTE #S IN SUBROUTINE: (1-84)  C4=37  FS4=43  C5=49  ETC.
01300	C   F1=86  F15=100 (NO F16!)
01400	
01500		DIMENSION RH(20,5),Z(5)
01600	C  SETS UP 2-DIMENSIONAL ARRAY FOR RHYTHS.  Z IS FOR STORAGE.
01700	
01800		J=CNT(INUM)
01900		IF(J.NE.1)GO TO 10
02000	
02100		XDUR=DUR(INUM)
02200	C  SAVES ORIGINAL GIVEN DURATION.
02300		DUR(INUM)=1000
02400	C  SO THERE WILL BE ENOUGH ROOM FOR LAST RHYTH. STRING.
02500	
02600		J2=P(2)
02700	C GETS POINTER TO 1ST RHYTH. STRING.
02800	
02900		J3=P(3)
03000	C  GETS BEGIN POINT OF CHROM. SCALE.
03100	
03200		K=0
03300	C INITIALIZE THE COUNTER.
03400	
03500		M=1
03600	C  M WILL DETERMINE THE DIRECTION OF CHROM. SCALE.
03700	
03800		DO 20 L=1,5
03900	20	Z(L)=0
04000	C  ZERO ALL 'Z' STORAGE.
04100	
04200	10	IF(J.GT.20)GO TO 1
04300	C  THE FIRST 20 NOTES WILL LOAD UP THE RHYTH. STORAGE SLOTS.
04400	
04500		DO 100 L=1,5
04600		IF(Z(L).GT.20)GO TO 100
04700	C  LOOKS AT PREVIOUS VALUE. SKIPS IF IT WAS AN END MARK.
04800	
04900		Z(L)=P(L+10)
05000	C  SAVES VALUES FROM P11→P15
05100	
05200		RH(J,L)=Z(L)
05300	C  PUT IT AWAY 
05400	
05500	100	CONTINUE
05600	
05700	1	K=K+1
05800	C  UPDATE COUNTER
05900	
06000		X=RH(K,J2)
06100	C  PICKS UP RHYTHM NUMBER K.
06200	
06300		IF(X.LT.20)GO TO 2
06400	C  JUMP IF NOT END MARK.  RHYTH VALUE OF .1=40, HENCE END MARK.
06500	
06600		K=1
06700	C  RESET COUNTER
06800	
06900		M=-M
07000	C CHANGE THE DIRECTION OF NEXT SCALE.
07100	
07200		J2=P(2)
07300	C PICK A NEW POINTER FOR RHYTH. STRINGS.
07400	
07500		J3=P(3)
07600	C  PICK UP NEW PITCH POINTER.
07700	
07800		IF(M.LT.0)J3=J3+24
07900	C  SHIFT UP 2 OCTAVES IF SCALE DIRECTION IS DOWNWARD.
08000	
08100		X=RH(K,J2)
08200	C  GET FIRST OF NEW STRING.
08300	
08400		IF(XDUR.GT.P(1))GO TO 2
08500	C  CHECK ON ORIGINAL DURATION.
08600	
08700		DUR(INUM)=0
08800	C  IF WE'VE PASSED ORIGINAL DUR. CAUSE ENDING NOW.
08900		X=-1
09000	C  LAST 'NOTE' IS A REST.
09100	
09200	2	P(2)=X
09300	C  PUT RHYTH. INTO P2
09400	
09500		P(3)=J3+K*M
09600	C  PUT NOTE NUM INTO P3.  M DETERMINES DIRECTION OF SCALE.
09700	
09710		IF(M.LT.0)P(7)=88
09720	C  WHEN DESCENDING, USE TOOT'S TONE.
09800		RETURN 
09900		END
10000	
10100	
10200	C  TYPICAL INPUT
10300	
10400	C CLAR 0 25;
10500	C P2  1  1,5.999; <POINTERS TO RHYTH. GROUPS
10600	C P3  1  C3,C5; 
10700	C P4 2000; P5 F1;  P7 F4;
10800	C P11 RHY/8/4/8/.1; < .1 MAKES END MARK
10900	C P12 RHY/ 12X6/ 20X5/ 4/ .1;
11000	C P13 RHY/ 4./ 16// 8// .1;
11100	C P14 RHY/ 4/ 16/ 8X4/ 16/ 4/ .1;
11200	C P15 SUBN RHY/ 16/ -8./ 16/ -16/ REP 2 / .1;
11300	C END;
11400	C TEMPO/120;